perm filename CATALO[PAT,LMM] blob
sn#097632 filedate 1974-04-15 generic text, type T, neo UTF8
(FILECREATED " 8-APR-74 02:49:40" CATALOG)
(LISPXPRINT (QUOTE CATALOGVARS)
T)
[RPAQQ CATALOGVARS ((FNS CATALOG PUTCATALOG)
(VARS (CATALOGTYPE)
(CATALOGTYPES (QUOTE (POLYGONAL GAUCHE NONPOLY]
(DEFINEQ
(CATALOG
[LAMBDA (TVL)
(SETQ TVL (TRIMZEROS TVL))
(* The CATALOG is contained in the CATALOG.DICTIONARY;
just does a LOOKUP on it)
(PROG (TEM)
(COND
[(SETQ TEM
(for X in (OR CATALOGTYPE CATALOGTYPES)
join
(APPEND
(CDDR
(PROG (FND FIL)
TRY1(SETQ FND (SASSOC (CONS X TVL)
(CDDDR CATDICT)))
(* Use SACCOC to find entry, if
any)
(OR (CDR FND)
(GO TRY2))
[PUSHCAR (CDDR CATDICT)
(NLEFT (CDDR CATDICT)
1
(FMEMB FND (CDDDR CATDICT]
(* Move the found entry to the
front of the dictionary)
(COND
((NULL (CDDR FND))
(* Read in from file, bump incore counter, and check if too
many incore, writing outsome; then return the value)
(SFPTR [SETQ FIL
(OR (OPENP (CAR CATDICT))
(INPUT (INFILE (CAR CATDICT]
(CADR FND))
(FRPLACD (CDR FND)
(READ FIL))
(FRPLACA (CDR CATDICT)
(ADD1 (CADR CATDICT)))
(WRITESOME CATDICT)
(* Check if need to bump some
out)
(RETURN FND))
(T (* It's already in core)
(RETURN FND)))
TRY2(SETQ FND (SASSOC (CONS X TVL)
(CDDDR CATALOG.DICTIONARY)))
(* Use SACCOC to find entry, if
any)
(OR FND (RETURN))
[PUSHCAR (CDDR CATALOG.DICTIONARY)
(NLEFT (CDDR CATALOG.DICTIONARY)
1
(FMEMB FND (CDDDR
CATALOG.DICTIONARY]
(* Move the found entry to the
front of the dictionary)
(AND (CDDR FND)
(GO GOTONE))
(* Read in from file, bump incore counter, and check if too
many incore, writing outsome; then return the value)
(SFPTR [SETQ FIL
(OR (OPENP (CAR CATALOG.DICTIONARY))
(INPUT (INFILE (CAR
CATALOG.DICTIONARY]
(CADR FND))
(FRPLACD (CDR FND)
(READ FIL))
GOTONE
(PUTCATALOG (CDAR FND)
(CAAR FND)
(MAPCAR (CDDR FND)
(QUOTE CONVERT)))
(FRPLACA (CDR CATALOG.DICTIONARY)
(ADD1 (CADR CATALOG.DICTIONARY)))
(WRITESOME CATALOG.DICTIONARY)
(* Check if need to bump some
out)
(SETQ FND)
(GO TRY1]
(T (LIST (create STRUCFORM (SETQ FORM (LIST (QUOTE CATALOG)
TVL])
(PUTCATALOG
[LAMBDA (TVL TYPE LISTOFSTRUCTURES)
(for X in LISTOFSTRUCTURES do (OR (type? STRUCTURE X)
(HELP))
(FIXUPGROUP X))
(ENTER (LOOKUP (CONS TYPE TVL)
CATDICT)
CATDICT LISTOFSTRUCTURES])
)
(RPAQ CATALOGTYPE)
(RPAQQ CATALOGTYPES (POLYGONAL GAUCHE NONPOLY))
STOP